home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 501-525 / disk_525 / siod / siod.h < prev    next >
C/C++ Source or Header  |  1992-05-06  |  3KB  |  133 lines

  1. /* Scheme In One Defun, but in C this time.
  2.  
  3.  *                        COPYRIGHT (c) 1989 BY                             *
  4.  *        PARADIGM ASSOCIATES INCORPORATED, CAMBRIDGE, MASSACHUSETTS.       *
  5.  *        See the source file SLIB.C for more information.                  *
  6.  
  7. */
  8.  
  9. struct obj
  10. {short gc_mark;
  11.  short type;
  12.  union {struct {struct obj * car;
  13.         struct obj * cdr;} cons;
  14.     struct {double data;} flonum;
  15.     struct {char *pname;
  16.         struct obj * vcell;} symbol;
  17.     struct {char *name;
  18.         struct obj * (*f)();} subr;
  19.     struct {struct obj *env;
  20.         struct obj *code;} closure;}
  21.  storage_as;};
  22.  
  23. #define CAR(x) ((*x).storage_as.cons.car)
  24. #define CDR(x) ((*x).storage_as.cons.cdr)
  25. #define PNAME(x) ((*x).storage_as.symbol.pname)
  26. #define VCELL(x) ((*x).storage_as.symbol.vcell)
  27. #define SUBRF(x) (*((*x).storage_as.subr.f))
  28. #define FLONM(x) ((*x).storage_as.flonum.data)
  29.  
  30. #define NIL ((struct obj *) 0)
  31. #define EQ(x,y) ((x) == (y))
  32. #define NEQ(x,y) ((x) != (y))
  33. #define NULLP(x) EQ(x,NIL)
  34. #define NNULLP(x) NEQ(x,NIL)
  35.  
  36. #define TYPE(x) (((x) == NIL) ? 0 : ((*(x)).type))
  37.  
  38. #define TYPEP(x,y) (TYPE(x) == (y))
  39. #define NTYPEP(x,y) (TYPE(x) != (y))
  40.  
  41. #define tc_nil    0
  42. #define tc_cons   1
  43. #define tc_flonum 2
  44. #define tc_symbol 3
  45. #define tc_subr_0 4
  46. #define tc_subr_1 5
  47. #define tc_subr_2 6
  48. #define tc_subr_3 7
  49. #define tc_lsubr  8
  50. #define tc_fsubr  9
  51. #define tc_msubr  10
  52. #define tc_closure 11
  53. #define tc_free_cell 12
  54. #define tc_user_1 13
  55. #define tc_user_2 14
  56. #define tc_user_3 15
  57. #define tc_user_4 16
  58. #define tc_user_5 17
  59.  
  60.  
  61. typedef struct obj* LISP;
  62.  
  63. #define CONSP(x)   TYPEP(x,tc_cons)
  64. #define FLONUMP(x) TYPEP(x,tc_flonum)
  65. #define SYMBOLP(x) TYPEP(x,tc_symbol)
  66.  
  67. #define NCONSP(x)   NTYPEP(x,tc_cons)
  68. #define NFLONUMP(x) NTYPEP(x,tc_flonum)
  69. #define NSYMBOLP(x) NTYPEP(x,tc_symbol)
  70.  
  71. #define TKBUFFERN 256
  72.  
  73. char *must_malloc();
  74.  
  75. LISP cons(), car(), cdr(), setcar();
  76. LISP setcdr(),consp();
  77.  
  78. LISP symcons(),rintern(), cintern();
  79. LISP cintern_soft();
  80. LISP symbolp();
  81.  
  82. LISP flocons();
  83. LISP plus(),ltimes(),difference();
  84. LISP quotient(), greaterp(), lessp();
  85.  
  86. LISP eq(),eql(),numberp();
  87. LISP assq();
  88.  
  89. LISP lread(),leval(),lprint(),lprin1();
  90.  
  91. LISP subrcons();
  92. LISP closure();
  93.  
  94. LISP leval_define(),leval_lambda(),leval_if();
  95. LISP leval_progn(),leval_setq(),leval_let(),let_macro();
  96. LISP leval_args(),extend_env(),setvar();
  97. LISP leval_quote(),leval_and(),leval_or();
  98. LISP oblistfn(),copy_list();
  99. LISP gc_relocate(),get_newspace(),gc_status();
  100. LISP vload(),load();
  101. LISP leval_tenv(),lerr(),quit(),nullp();
  102. LISP symbol_boundp(),symbol_value();
  103. LISP envlookup(),arglchk(),reverse();
  104.  
  105.  
  106. void gc_protect();
  107. void gc_protect_n();
  108.  
  109. long no_interrupt();
  110.  
  111. void init_subr();
  112.  
  113. LISP get_eof_val();
  114. void set_repl_hooks();
  115.  
  116. void set_gc_hooks();
  117.  
  118. void set_eval_hooks();
  119.  
  120. void set_print_hooks();
  121.  
  122. void set_read_hooks();
  123.  
  124. LISP gen_read();
  125.  
  126. struct gen_readio
  127. {int (*getc_fcn)();
  128.  void (*ungetc_fcn)();
  129.  char *cb_argument;};
  130.  
  131. #define GETC_FCN(x) (*((*x).getc_fcn))((*x).cb_argument)
  132. #define UNGETC_FCN(c,x) (*((*x).ungetc_fcn))(c,(*x).cb_argument)
  133.